home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DELPHI / DELPHCGI.ZIP / CGI.ZIP / SAMPLES / FORMLESS / CGIPROCS.PAS next >
Encoding:
Pascal/Delphi Source File  |  1995-07-17  |  3.6 KB  |  127 lines
  1. unit CGIProcs;
  2.  
  3. interface
  4.  
  5. uses
  6.     CGI,
  7.     SysUtils;
  8.  
  9. procedure SendOrderForm;
  10. procedure ProcessOrder;
  11. procedure RejectOrder(const Reason: String);
  12. procedure SendHeader(const Title: String);
  13. procedure SendFooter;
  14.  
  15. var
  16.     CGI1: TCGI;
  17.  
  18. implementation
  19.  
  20. procedure SendOrderForm;
  21. begin
  22.     with CGI1 do begin
  23.         SendHeader('Pizza Order Form');
  24.         Send('<FORM METHOD="POST" ACTION="/cgi-win/noform.exe">');
  25.         Send('<B>Godzilla''s Pizza -- Internet Delivery Service</B><P>');
  26.         Send('At present, we accept internet orders only for medium (13") size pizzas.');
  27.         Send('It is now ' + FormatDateTime('h:mm AM/PM', Now) +'. ');
  28.         Send('You will have your pizza by ' + FormatDateTime('h:mm AM/PM', Now + EncodeTime(0,45,0,0)) + '.');
  29.         Send('<PRE>');
  30.         Send('          Name: <INPUT SIZE=30 NAME="name">');
  31.         Send('Street address: <INPUT SIZE=30 NAME="address">');
  32.         Send('  Phone number: <INPUT SIZE=15 NAME="phone">');
  33.         Send('          City: <SELECT NAME="city">');
  34.         Send('                <OPTION SELECTED>Pasadena (free)');
  35.         Send('                <OPTION>Altadena (free)');
  36.         Send('                <OPTION>So. Pasadena ($1.00)');
  37.         Send('                <OPTION>Arcadia ($1.00)');
  38.         Send('                <OPTION>Monrovia ($2.50)');
  39.         Send('                </SELECT>');
  40.         Send('</PRE>');
  41.         Send('Which toppings would you like? <BR>');
  42.         Send('<OL>');
  43.         Send('<LI> <INPUT TYPE="checkbox" NAME="topping" VALUE="pepperoni"> Pepperoni.');
  44.         Send('<LI> <INPUT TYPE="checkbox" NAME="topping" VALUE="sausage"> Sausage.');
  45.         Send('<LI> <INPUT TYPE="checkbox" NAME="topping" VALUE="anchovies"> Anchovies.');
  46.         Send('</OL>');
  47.         Send('To order your pizza, press this button: <INPUT TYPE="submit" VALUE="Order Pizza">.');
  48.         Send('</FORM>');
  49.     end;
  50.     SendFooter;
  51. end;
  52.  
  53. procedure ProcessOrder;
  54. var
  55.     Name,
  56.    Address,
  57.     City,
  58.     Phone,
  59.     Toppings: String;
  60.     i: Char;
  61. begin
  62.     with CGI1.FormFields do begin
  63.         Name := Values['name'];
  64.         Address := Values['address'];
  65.         Phone := Values['phone'];
  66.         City := Values['city'];
  67.         Toppings := Values['topping'];
  68.  
  69.         i := '1';
  70.         while IndexOfKey('topping_'+i) > -1 do begin
  71.             Toppings := Toppings + ', ' + Values['topping_'+i];
  72.             Inc(i);
  73.         end;
  74.     end;
  75.  
  76.     if (Name = '') or (Address = '') or (Phone = '') or (City = '') then
  77.         RejectOrder('you didn''t fill in all of the fields')
  78.     else begin
  79.         SendHeader('Order Confirmation');
  80.         with CGI1 do begin
  81.             Send('<H1>Order Confirmation</H1>');
  82.             Send('Your order has been received, and appears valid. Here it is:');
  83.             Send('<PRE>');
  84.             Send('          Name: ' + Name);
  85.             Send('Street address: ' + Address);
  86.             Send('  Phone number: ' + Phone);
  87.             Send('          City: ' + City);
  88.             Send('      Toppings: ' + Toppings);
  89.             Send('</PRE>');
  90.             Send('If you have any corrections, please call 555-555-5555 immediately!');
  91.         end;
  92.         SendFooter;
  93.     end;
  94. end;
  95.  
  96. procedure SendHeader(const Title: String);
  97. begin
  98.     with CGI1 do begin
  99.         Send('<HTML><HEAD><TITLE>' + Title + '</TITLE></HEAD>');
  100.         Send('<BODY>');
  101.     end;
  102. end;
  103.  
  104. procedure SendFooter;
  105. begin
  106.     with CGI1 do begin
  107.         Send('<HR>');
  108.         Send('Click below to send mail to our order desk:<BR>');
  109.         Send('<A HREF="mailto:Orders@Godzilla.com">');
  110.         Send('<ADDRESS><Orders@Godzilla.com></ADDRESS></A>');
  111.         Send('</BODY></HTML>');
  112.     end;
  113. end;
  114.  
  115. procedure RejectOrder(const Reason: String);
  116. begin
  117.     SendHeader('Order Rejected');
  118.     with CGI1 do begin
  119.         Send('<H1>Can''t process your order</H1>');
  120.         Send('We can''t process your order because ' + Reason + '. ');
  121.         Send('Please correct your order and re-send it.');
  122.     end;
  123.     SendFooter;
  124. end;
  125.  
  126. end.
  127.